home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / filename.mlp < prev    next >
Encoding:
Text File  |  1993-09-24  |  3.4 KB  |  160 lines  |  [TEXT/MPS ]
  1. (* filename.mlp *)
  2.  
  3. (**) #open "int";;
  4. (**) #open "eq";;
  5. (**) #open "fstring";;
  6. (**) #open "exc";;
  7.  
  8. let check_suffix name suff =
  9.  string_length name >= string_length suff &
  10.  sub_string name (string_length name - string_length suff) (string_length suff)
  11.     = suff
  12. ;;
  13.  
  14. let chop_suffix name suff =
  15.   sub_string name 0 (string_length name - string_length suff)
  16. ;;
  17.  
  18. #ifdef unix
  19. let current_dir_name = ".";;
  20.  
  21. let concat dirname filename =
  22.   let l = string_length dirname - 1 in
  23.   if l < 0 or nth_char dirname l == `/`
  24.   then dirname ^ filename
  25.   else dirname ^ "/" ^ filename
  26. ;;
  27.  
  28. let is_absolute n =
  29.      (string_length n >= 1 & sub_string n 0 1 = "/")
  30.   or (string_length n >= 2 & sub_string n 0 2 = "./")
  31.   or (string_length n >= 3 & sub_string n 0 3 = "../")
  32. ;;
  33.  
  34. let slash_pos s =
  35.   let rec pos i =
  36.     if i < 0 then raise Not_found
  37.     else if nth_char s i == `/` then i
  38.     else pos (i - 1)
  39.   in pos (string_length s - 1)
  40. ;;
  41.  
  42. let basename name =
  43.   try
  44.     let p = slash_pos name + 1 in
  45.       sub_string name p (string_length name - p)
  46.   with Not_found ->
  47.     name
  48. ;;
  49.  
  50. let dirname name =
  51.   if name = "/" then name else
  52.     try
  53.       sub_string name 0 (slash_pos name)
  54.     with Not_found ->
  55.       "."
  56. ;;
  57. #endif
  58.  
  59. #ifdef macintosh
  60. let current_dir_name = ":";;
  61.  
  62. let is_absolute n =
  63.   try
  64.     for i = 0 to string_length n - 1 do
  65.       if nth_char n i == `:` then raise Exit
  66.     done;
  67.     false
  68.   with Exit ->
  69.     true
  70. ;;
  71.  
  72. let concat dirname filename =
  73.   let dirname1 =
  74.     if is_absolute dirname
  75.     then dirname
  76.     else ":" ^ dirname in
  77.   let l =
  78.     string_length dirname1 - 1 in
  79.   let dirname2 =
  80.     if l < 0 or nth_char dirname1 l == `:`
  81.     then dirname1
  82.     else dirname1 ^ ":" in
  83.   let filename2 =
  84.     if string_length filename > 0 & nth_char filename 0 == `:`
  85.     then sub_string filename 1 (string_length filename - 1)
  86.     else filename in
  87.   dirname2 ^ filename2
  88. ;;
  89.  
  90. let colon_pos s =
  91.   let rec pos i =
  92.     if i < 0 then raise Not_found else
  93.     if nth_char s i == `:` then i else pos (i - 1)
  94.   in pos (string_length s - 1)
  95. ;;
  96.  
  97. let basename name =
  98.   try
  99.     let p = colon_pos name + 1 in
  100.       sub_string name p (string_length name - p)
  101.   with Not_found ->
  102.     name
  103. ;;
  104.  
  105. let dirname name =
  106.   if name = ":" then name else
  107.     try
  108.       sub_string name 0 (colon_pos name)
  109.     with Not_found ->
  110.       ":"
  111. ;;
  112. #endif
  113.  
  114. #ifdef msdos
  115. let current_dir_name = ".";;
  116.  
  117. let concat dirname filename =
  118.   let l = string_length dirname - 1 in
  119.   if l < 0 or nth_char dirname l == `\\` or nth_char dirname l == `:`
  120.   then dirname ^ filename
  121.   else dirname ^ "\\" ^ filename
  122. ;;
  123.  
  124. let is_absolute n =
  125.      (string_length n >= 2 & nth_char n 1 == `:`)
  126.   or (string_length n >= 1 & sub_string n 0 1 = "\\")
  127.   or (string_length n >= 2 & sub_string n 0 2 = ".\\")
  128.   or (string_length n >= 3 & sub_string n 0 3 = "..\\")
  129. ;;
  130.  
  131. let sep_pos s =
  132.   let rec pos i =
  133.     if i < 0 then raise Not_found else
  134.       match nth_char s i with
  135.         `/` | `\\` | `:` -> i
  136.       | _ -> pos (i - 1)
  137.   in pos (string_length s - 1)
  138. ;;
  139.  
  140. let basename name =
  141.   try
  142.     let p = sep_pos name + 1 in
  143.       sub_string name p (string_length name - p)
  144.   with Not_found ->
  145.     name
  146. ;;
  147.  
  148. let rec dirname name =
  149.   if string_length name >= 2 & nth_char name 1 == `:` then
  150.     sub_string name 0 2 ^ dirname (sub_string name 2 (string_length name - 2))
  151.   else if name = "/" or name = "\\" then
  152.     name
  153.   else
  154.     try
  155.       sub_string name 0 (sep_pos name)
  156.     with Not_found ->
  157.       "."
  158. ;;
  159. #endif
  160.